{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit CoverListForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, CoverSearch, MediaRepository, MediaSchema,
  PngImageList, ComCtrls, Menus, ActnList;

type
  TfrmCoverList = class(TForm)
    Bevel1: TBevel;
    Bevel2: TBevel;
    pbHeader: TPaintBox;
    lbCaption: TLabel;
    lbAction: TLabel;
    btClose: TButton;
    lvCovers: TListView;
    pmCovers: TPopupMenu;
    alActions: TActionList;
    acSearch: TAction;
    Searchforcover1: TMenuItem;
    acCustom: TAction;
    Customsearch1: TMenuItem;
    acRemove: TAction;
    N1: TMenuItem;
    Removecover1: TMenuItem;
    lbStatus: TLabel;
    pbProgress: TProgressBar;
    btStop: TButton;
    btStart: TButton;
    acStart: TAction;
    acStop: TAction;
    tmAutoSearch: TTimer;
    acBrowse: TAction;
    BrowseImage1: TMenuItem;
    procedure pbHeaderPaint(Sender: TObject);
    procedure btCloseClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure acSearchExecute(Sender: TObject);
    procedure acSearchUpdate(Sender: TObject);
    procedure acCustomUpdate(Sender: TObject);
    procedure acCustomExecute(Sender: TObject);
    procedure acRemoveUpdate(Sender: TObject);
    procedure acRemoveExecute(Sender: TObject);
    procedure lvCoversDblClick(Sender: TObject);
    procedure acStartExecute(Sender: TObject);
    procedure acStartUpdate(Sender: TObject);
    procedure acStopExecute(Sender: TObject);
    procedure acStopUpdate(Sender: TObject);
    procedure tmAutoSearchTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure acBrowseExecute(Sender: TObject);
    procedure acBrowseUpdate(Sender: TObject);
  private
    { Private declarations }
    FThumbPath: WideString;
    FCovers: TAHMCoverSearcher;
    FSchema: TAHMMediaSchema;
    FHeaderImages: TPngImageList;
    FCoverImages: TPngImageList;
    FScanning: Boolean;
    FWorking: Boolean;
    FSleeping: Integer;
    FMissing: Integer;
    FCurrent: Integer;
    FProgress: Integer;
    FSearchText: String;
    FSourceFile: String;
    function CleanSuffix(DirtyText: String): String;
    function GetDefaultSearchText(Item: TListItem): String;
    function GetCustomSearchText(Item: TListItem): String;
    function SearchCover(SearchText: String; Item: TListItem): Boolean;
    function ImportCover(SourceFile: String; Item: TListItem): Boolean;
    function DeleteCover(Item: TListItem): Boolean;
    function UpdateCover(LocalFile: WideString; Item: TListItem): Boolean;
    procedure LoadAlbums;
    procedure LoadImages;
    procedure ConfigureDisplay;
    procedure UpdateUI;
  public
    { Public declarations }
    property Schema: TAHMMediaSchema read FSchema write FSchema;
    property ThumbnailPath: WideString read FThumbPath write FThumbPath;
    class function ViewCovers(Repository: TAHMMediaRepository): Boolean;
  end;

implementation

{$R *.dfm}

uses DesignerString, UniCode, TagUtils, ImageUtils, Utilities, JclFileUtils,
     PngImage, AHMConsts;

var
  FormInstance: TfrmCoverList;

//-----------------------------------------------------------------------------
//----------------------------- Class Functions -------------------------------
//-----------------------------------------------------------------------------

class function TfrmCoverList.ViewCovers(Repository: TAHMMediaRepository): Boolean;
begin
  // Set default result - unchanged
  Result := False;

  // Create a singleton form instance
  if not Assigned(FormInstance) then
  begin
    FormInstance := TfrmCoverList.Create(Application.MainForm);
    FormInstance.PopupParent := Application.MainForm;
  end;

  FormInstance.Schema := Repository.Schema;
  FormInstance.ThumbnailPath := Repository.ThumbnailPath;

  if FormInstance.ShowModal = mrOK then
  begin
    Result := True;
  end;
end;

//-----------------------------------------------------------------------------
//----------------------------- Form Events -----------------------------------
//-----------------------------------------------------------------------------

procedure TfrmCoverList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // Stop searching when form closes
  Screen.Cursor := crDefault;
  FScanning := False;
end;

procedure TfrmCoverList.FormCreate(Sender: TObject);
begin
  // Create PNG image lists
  FHeaderImages := TPngImageList.Create(Self);
  FCoverImages := TPngImageList.Create(Self);
  lvCovers.LargeImages := FCoverImages;

  // Create cover search helper
  FCovers := TAHMCoverSearcher.Create;
end;

procedure TfrmCoverList.FormDestroy(Sender: TObject);
begin
  FCovers.Free;
end;

procedure TfrmCoverList.FormShow(Sender: TObject);
begin
  // Populate list of known albums from media schema
  LoadImages;
  LoadAlbums;
  ConfigureDisplay;
end;

//-----------------------------------------------------------------------------
//------------------------------ Action Events --------------------------------
//-----------------------------------------------------------------------------

procedure TfrmCoverList.acBrowseExecute(Sender: TObject);
begin
  if ChooseFile('Select cover image', FILTER_IMAGES, '', '', FSourceFile, False) then
    ImportCover(FSourceFile, lvCovers.Selected);
end;

procedure TfrmCoverList.acBrowseUpdate(Sender: TObject);
begin
  acBrowse.Enabled := Assigned(lvCovers.Selected) and not FScanning;
end;

procedure TfrmCoverList.acCustomExecute(Sender: TObject);
var
  SearchText: String;
begin
  SearchText := GetCustomSearchText(lvCovers.Selected);

  Screen.Cursor := crHourglass;
  try
    SearchCover(SearchText, lvCovers.Selected);
    UpdateUI;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TfrmCoverList.acCustomUpdate(Sender: TObject);
begin
  acCustom.Enabled := Assigned(lvCovers.Selected) and not FScanning;
end;

procedure TfrmCoverList.acRemoveExecute(Sender: TObject);
begin
  DeleteCover(lvCovers.Selected);
end;

procedure TfrmCoverList.acRemoveUpdate(Sender: TObject);
begin
  acRemove.Enabled := Assigned(lvCovers.Selected) and
                      (lvCovers.Selected.ImageIndex > 0) and
                      not FScanning;
end;

procedure TfrmCoverList.acSearchExecute(Sender: TObject);
var
  SearchText: String;
begin
  SearchText := GetDefaultSearchText(lvCovers.Selected);

  Screen.Cursor := crHourglass;
  try
    SearchCover(SearchText, lvCovers.Selected);
    UpdateUI;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TfrmCoverList.acSearchUpdate(Sender: TObject);
begin
  acSearch.Enabled := Assigned(lvCovers.Selected) and not FScanning;
end;

procedure TfrmCoverList.acStartExecute(Sender: TObject);
begin
  // Start another auto search
  Screen.Cursor := crHourglass;
  ConfigureDisplay;
  FScanning := True;
  UpdateUI;
end;

procedure TfrmCoverList.acStartUpdate(Sender: TObject);
begin
  acStart.Enabled := (FMissing > 0) and not FScanning;
end;

procedure TfrmCoverList.acStopExecute(Sender: TObject);
begin
  // Stop current auto search
  Screen.Cursor := crDefault;
  FScanning := False;
  UpdateUI;
end;

procedure TfrmCoverList.acStopUpdate(Sender: TObject);
begin
  acStop.Enabled := FScanning;
end;

//-----------------------------------------------------------------------------
//----------------------------- Control Events --------------------------------
//-----------------------------------------------------------------------------

procedure TfrmCoverList.pbHeaderPaint(Sender: TObject);
begin
  with pbHeader do
  begin
    // Draw background
    Canvas.Brush.Color := clWhite;
    Canvas.FillRect(GetClientRect);
    // Draw appropriate header image
    FHeaderImages.Draw(Canvas, ClientWidth - FHeaderImages.Width, 0, 0);
  end;
end;

procedure TfrmCoverList.btCloseClick(Sender: TObject);
begin
  ModalResult := mrOK;
end;

procedure TfrmCoverList.lvCoversDblClick(Sender: TObject);
begin
  // Default action on double click is to perform a search
  if Assigned(lvCovers.Selected) and not FScanning then acSearch.Execute;
end;

procedure TfrmCoverList.tmAutoSearchTimer(Sender: TObject);
var
  Item: TListItem;
begin
  // Ignore this event whilst sleeping between requests
  if FSleeping > 0 then
  begin
    Dec(FSleeping);
    Exit;
  end;

  // Ignore this event whilst performing a request or sleeping
  if FWorking or not FScanning then Exit;

  FWorking := True;
  try
    Item := nil;

    // Get next listview item with missing album art
    while FCurrent < lvCovers.Items.Count do
    begin
      Item := lvCovers.Items[FCurrent];
      if Item.ImageIndex = 0 then Break
                             else Inc(FCurrent);
    end;

    // If we found an item to update then search it
    if Assigned(Item) then
    begin
      FSearchText := GetDefaultSearchText(Item);
      SearchCover(FSearchText, Item);
    end
    else
    begin
      // No more items left - scanning complete
      Screen.Cursor := crDefault;
      FScanning := False;
    end;

    // Update status
    Inc(FCurrent);
    Inc(FProgress);
    UpdateUI;

    // After completing request, wait one second to avoid flooding server
    FSleeping := 10;
  finally
    FWorking := False;
  end;
end;

//-----------------------------------------------------------------------------
//---------------------------- Helper Functions -------------------------------
//-----------------------------------------------------------------------------

function TfrmCoverList.CleanSuffix(DirtyText: String): String;
var
  i, j: Integer;
begin
  // Remove disc suffix from text
  i := LastDelimiter('([{', DirtyText);
  j := LastDelimiter(')]}', DirtyText);
  if (i > 1) and (i < j) then Delete(DirtyText, i, j - i + 1);

  Result := Trim(DirtyText);
end;

function TfrmCoverList.GetDefaultSearchText(Item: TListItem): String;
begin
  // Concatenate artist + album name
  if Assigned(Item) then
    Result := CleanSuffix(Item.SubItems[0]) + ' ' +
              CleanSuffix(Item.SubItems[1])
  else
    Result := '';
end;

function TfrmCoverList.GetCustomSearchText(Item: TListItem): String;
begin
  // Get default search text first
  Result := GetDefaultSearchText(Item);

  // Then allow user to tweak it
  if Result <> '' then
    if not TfrmDesignerString.EditString('Search Text', 'Enter search text',
                                         'Customise search text for online search below',
                                         'Search:', Result) then
      Result := '';
end;

function TfrmCoverList.SearchCover(SearchText: String; Item: TListItem): Boolean;
var
  AlbumId: Integer;
  ImageFilename: WideString;
begin
  // Set default result - failed to download cover
  Result := False;

  if Assigned(Item) and (SearchText <> '') and FCovers.Search(SearchText) then
  begin
    // Generate thumbnail filename
    AlbumId := Integer(Item.Data);
    ImageFilename := FThumbPath + GetThumbnailName(FSchema.GetAlbumHash(AlbumId));

    if FCovers.Download(ImageFilename) then
    begin
      // Cover downloaded, update database and listview image
      Result := UpdateCover(ImageFilename, Item);
    end;
  end;
end;

function TfrmCoverList.ImportCover(SourceFile: String; Item: TListItem): Boolean;
var
  AlbumId: Integer;
  ImageFilename: WideString;
begin
  // Set default result - failed to import cover
  Result := False;

  if Assigned(Item) and FileExists(SourceFile) then
  begin
    // Generate thumbnail filename
    AlbumId := Integer(Item.Data);
    ImageFilename := FThumbPath + GetThumbnailName(FSchema.GetAlbumHash(AlbumId));

    // Copy file to thumbnail folder
    FileCopy(SourceFile, ImageFilename);

    // Update database and listview image
    Result := UpdateCover(ImageFilename, Item);
  end;
end;

function TfrmCoverList.UpdateCover(LocalFile: WideString; Item: TListItem): Boolean;
var
  AlbumId: Integer;
  Image: TPngObject;
begin
  // Set default result - failed to update cover
  Result := False;

  if Assigned(Item)  then
  begin
    AlbumId := Integer(Item.Data);

    // Cover updated, update database
    FSchema.UpdateAlbumArt(AlbumId, EncodeWideString(LocalFile));

    // Now update listview image
    Image := LoadImage(LocalFile, FCoverImages.Width, FCoverImages.Height);
    if Assigned(Image) then
    begin
      // Update status
      if Item.ImageIndex = 0 then Dec(FMissing);

      // Always add a new image as rebuilding image list takes a while
      FCoverImages.AddPng(Image);
      Item.ImageIndex := Pred(FCoverImages.Count);
     Image.Free;
    end
    else
    begin
      // Update status
      if Item.ImageIndex > 0 then Inc(FMissing);

      // Don't delete image as it would break list ordering
      Item.ImageIndex := 0;
    end;

    // Success
    Result := True;
  end;
end;

function TfrmCoverList.DeleteCover(Item: TListItem): Boolean;
var
  AlbumId: Integer;
begin
  // Set default result - failed to delete cover
  Result := False;

  if Assigned(Item) then
  begin
    AlbumId := Integer(Item.Data);

    // Cover deleted, update database
    FSchema.UpdateAlbumArt(AlbumId, '');

    // Now update listview image
    Item.ImageIndex := 0;

    // Update status
    Inc(FMissing);
    UpdateUI;

    // Success
    Result := True;
  end;
end;

//-----------------------------------------------------------------------------
//-------------------------- User Interface Update ----------------------------
//-----------------------------------------------------------------------------

procedure TfrmCoverList.LoadAlbums;
var
  i: Integer;
  Album: PAlbumInfo;
  Artist: PArtistInfo;
  Image: TPngObject;
begin
  // Reset count of missing covers
  FMissing := 0;

  Screen.Cursor := crHourglass;
  lvCovers.Items.BeginUpdate;
  lvCovers.Items.Clear;
  FCoverImages.BeginUpdate;
  try
    // Populate list of all albums in schema, initially with empty album art
    for i := 1 to Pred(FSchema.AlbumCount) do
    begin
      Album := FSchema.Albums[i];
      Artist := FSchema.Artists[Album.ArtistId];

      with lvCovers.Items.Add do
      begin
        Caption := Artist.Name + ' - ' + Album.Name;
        SubItems.Add(Artist.Name);
        SubItems.Add(Album.Name);
        Data := Pointer(i);

        // Set default image index - no album art
        ImageIndex := 0;

        // If album art URL populated, attempt to load as a bitmap
        if Album.ImageURL <> '' then
        begin
          Image := LoadImage(DecodeWideString(Album.ImageURL),
                             FCoverImages.Width, FCoverImages.Height);
          if Assigned(Image) then
          begin
            FCoverImages.AddPng(Image);
            ImageIndex := Pred(FCoverImages.Count);
            Image.Free;
          end;
        end
        else
          Inc(FMissing);
      end;
    end;
  finally
    FCoverImages.EndUpdate;
    lvCovers.Items.EndUpdate;
    Screen.Cursor := crDefault;
  end;
end;

procedure TfrmCoverList.LoadImages;
begin
  with FHeaderImages do
  begin
    Clear;
    Width := 150; Height := 57;

    AddResourcePng('HD_IMG_GENERIC'); //0
  end;

  with FCoverImages do
  begin
    Clear;
    Width := 85; Height := 85;

    AddResourcePng('THUMB_IMAGE_EMPTY'); //0
  end;
end;

procedure TfrmCoverList.ConfigureDisplay;
begin
  // Initial state - idle
  FScanning := False;
  FWorking := False;
  FSleeping := 0;
  FCurrent := 0;
  FProgress := 0;
  FSearchText := '';

  // Configure progress bar
  pbProgress.Max := FMissing;
  pbProgress.Position := 0;

  // Update UI state
  UpdateUI;
end;

procedure TfrmCoverList.UpdateUI;
begin
  // Update status text
  if FScanning then
    lbStatus.Caption := 'Searching ' + IntToStr(FProgress) + '/' +
                        IntToStr(pbProgress.Max) + ': ' + FSearchText
  else if FMissing > 1 then
    lbStatus.Caption := IntToStr(FMissing) + ' covers missing'
  else if FMissing > 0 then
    lbStatus.Caption := '1 cover missing'
  else
    lbStatus.Caption := 'No covers missing';

  // Update progress bar
  if FScanning then
    pbProgress.Position := FProgress
  else
    pbProgress.Position := 0;
end;

end.
